home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PARAMS / CMDLINE.PAS next >
Pascal/Delphi Source File  |  1994-12-09  |  13KB  |  458 lines
  1. unit CmdLine;
  2.  
  3. {*******************************************************}
  4. {                                                        }
  5. {        Copyright 1992, 1994 by James M. Clark.            }
  6. {                                                        }
  7. {        OOP version of Params unit                      }
  8. {                                                       }
  9. {        Handles command-line parameters;                }
  10. {        can also set default options.                    }
  11. {        See also: skel.pas, pardemo.pas,                }
  12. {        config.exe, config.doc                            }
  13. {                                                        }
  14. {*******************************************************}
  15.  
  16. interface
  17.  
  18. uses Dos, Objects;
  19.  
  20. type
  21.     PCmdLine = ^TCmdLine;
  22.     TCmdLine = object(TObject)
  23.         Option: string[3];    {e.g., the '/c' in '/c12'}
  24.         OptChr: char;        {e.g., the 'c'    in '/c12'}
  25.         OptStr: string;     {e.g., the '12' in '/c12'}
  26.         Dir:    DirStr;     {full pathname of directory}
  27.         SRec:    SearchRec;    {full details}
  28.  
  29.         ParNo:    integer;    {number of current parameter}
  30.         FileNo: word;        {number of current file}
  31.         FPars:    word;        {number of expanded parameters}
  32.         MayExpand: boolean; {enables filename expansion}
  33.         AttrMask: word;     {file types to find}
  34.  
  35.         constructor Init(Expand: boolean);
  36.         procedure AppDone; virtual;
  37.         procedure ChkFlg;
  38.         procedure DoFile(FName: PathStr; Expdd: boolean);
  39.                     virtual; {abstract}
  40.         function ExtendOpt: ExtStr;
  41.         function GetBool: boolean;
  42.         function GetInt: integer;
  43.         procedure ParseOpts(ParStr: string);
  44.         procedure RptError(Complaint, Name: string;
  45.                     Dispose: char); virtual;
  46.         procedure ScanPars;
  47.         procedure SetOpt; virtual; {abstract}
  48.         procedure ShowUsage; virtual; {abstract}
  49.     end;
  50.  
  51. {-------------------------------------------------------}
  52.  
  53. { globals }
  54.  
  55. {ExeDir: Get directory of program file if possible, else '':}
  56. function ExeDir: DirStr;
  57.  
  58. {ExeName: Get name of program file if possible, else '':}
  59. function ExeName: NameStr;
  60.  
  61. {GetDefaults: get default option string:}
  62. {strips any trailing '/' (padding) characters}
  63. function GetDefaults(DefOpts: string): string;
  64.  
  65. {StripPadding: strip any trailing '/' (padding) characters:}
  66. function StripPadding(Opts: string): string;
  67.  
  68. {*******************************************************}
  69.  
  70. implementation
  71.  
  72. const
  73.     {error messages; used with RptError procedure:}
  74.     sCantFind    = 'Can not find file(s)';
  75.     sBadBool    = 'Option value should be ''+'' or ''-''';
  76.     sBadInt     = 'Option value should be an integer';
  77.     sBadFlag    = 'Extra characters after option';
  78.  
  79.     {corresponding disposal modes; used with RptError procedure:}
  80.     dCantFind:    char = 'i';     {used by ScanPars}
  81.     dBadBool:    char = 'u';     {used by GetBool}
  82.     dBadInt:    char = 'u';     {used by GetInt}
  83.     dBadFlag:    char = 'u';     {used by ChkFlg}
  84.  
  85.     Copyright = 'CmdLine.tpu (C) 12-09-94 J. M. Clark';
  86.  
  87. {*******************************************************}
  88.  
  89. { TCmdLine }
  90.  
  91. constructor TCmdLine.Init(Expand: boolean);
  92. begin
  93.     inherited Init;
  94.     ParNo:= -1; {number of current parameter}
  95.     FileNo:= 0; {number of current file}
  96.     FPars:= 0;    {number of expanded parameters}
  97.     MayExpand:= Expand;    {enables filename expansion}
  98.     AttrMask:= AnyFile-Directory-VolumeID;    {file types to find}
  99. end; {TCmdLine.Init}
  100.  
  101. {-------------------------------------------------------}
  102.  
  103. {AppDone: prepare to exit from the application:}
  104. procedure TCmdLine.AppDone;
  105. begin
  106.     {do anything needed for an orderly exit}
  107.     {.. but don't halt}
  108. end; {TCmdLine.AppDone}
  109.  
  110. {----------------------------------------------------------}
  111.  
  112. {ChkFlg: check if extra characters after a simple flag:}
  113. {for example, /fxy when /f was expected}
  114.  
  115. procedure TCmdLine.ChkFlg;
  116. begin
  117.     if OptStr <> '' then RptError(sBadFlag, Option, dBadFlag);
  118. end; {TCmdLine.ChkFlg}
  119.  
  120. {-------------------------------------------------------}
  121.  
  122. {DoFile: process the file (or name) FName:}
  123. {
  124.     If Expdd = true, FName is expanded name of file found in Dir,
  125.     and global variables Path, Dir, and SRec may be used;
  126.     else, FName is just the ParStr, and not necessarily a filename.
  127.     Use "IsFile" to count FName as a file.
  128. }
  129.  
  130. procedure TCmdLine.DoFile(FName: PathStr; Expdd: boolean);    {over-ride}
  131. begin
  132.     Abstract;
  133. end; {TCmdLine.DoFile}
  134.  
  135.     { outline of method to override }
  136. (***
  137.     procedure IsFile;
  138.     begin
  139.         if not Expdd then begin
  140.             inc(FileNo);  inc(FPars);
  141.         end;
  142.     end;
  143.  
  144. begin {DoFile}
  145.     {process file here according to options}
  146. end;
  147. ***)
  148.  
  149. {-------------------------------------------------------}
  150.  
  151. {ExtendOpt: Extend the option name (OptChr) by taking one}
  152. {character from the option value (OptStr) if available:  }
  153. {If OptStr is '', then append '/' to OptChr instead.     }
  154.  
  155. function TCmdLine.ExtendOpt: ExtStr;
  156. begin
  157.     if Length(OptStr) > 0 then begin
  158.         Option:= Option + OptStr[1];
  159.         ExtendOpt:= OptChr + OptStr[1];
  160.         Delete(OptStr, 1, 1);
  161.     end else begin
  162.         ExtendOpt:= OptChr + '/';    {converts char to string}
  163.     end;
  164. end; {TCmdLine.ExtendOpt}
  165.  
  166. {-------------------------------------------------------}
  167.  
  168. {GetBool: convert option string OptStr to a boolean value:}
  169.  
  170. function TCmdLine.GetBool: boolean;
  171. begin
  172.     if (OptStr = '') or (OptStr = '+') then GetBool:= true
  173.     else if              OptStr = '-'  then GetBool:= false
  174.     else RptError(sBadBool, Option, dBadBool);
  175. end; {TCmdLine.GetBool}
  176.  
  177. {-------------------------------------------------------}
  178.  
  179. {GetInt: convert option string OptStr to an integer value:}
  180.  
  181. function TCmdLine.GetInt: integer;
  182. var
  183.     int, err: integer;
  184. begin
  185.     Val(OptStr, int, err);
  186.     if err = 0 then GetInt:= int
  187.     else RptError(sBadInt, Option, dBadInt);
  188. end; {TCmdLine.GetInt}
  189.  
  190. {-------------------------------------------------------}
  191.  
  192. {ParseOpts: scan parameter string ParStr and collect option data:}
  193. {options start with '/' and may run together, e.g.: /b+/c12/d-/eString }
  194. {or may be separated by spaces, e.g.: /b+ /c12     /d- /eString }
  195. {uses PSetOpt to define the options}
  196.  
  197. procedure TCmdLine.ParseOpts(ParStr: string);
  198. var
  199.     ChrPos: integer; {search position in ParStr}
  200. begin
  201.     {we begin with the assumption that ParStr[1] = '/'}
  202.     while Length(ParStr) > 1 do begin        {quit if ParStr end is '/'}
  203.         OptChr:= ParStr[2];
  204.         if OptChr = '/' then exit;            {quit if '//' is found}
  205.         Option:= '/'+OptChr;
  206.  
  207.         {delete the '/' and OptChr from ParStr:}
  208.         Delete(ParStr, 1, 2);
  209.         ChrPos:= Pos(' ', ParStr);            {look for a space, else..}
  210.         if ChrPos = 0
  211.         then ChrPos:= Pos('/', ParStr);     {look for another '/'}
  212.  
  213.         {if no more '/', then OptStr is all remaining of ParStr:}
  214.         if ChrPos = 0 then begin
  215.             OptStr:= ParStr;
  216.             SetOpt; {interpret OptChr and OptStr}
  217.             exit;
  218.  
  219.         end else begin
  220.             OptStr:= Copy(ParStr, 1, ChrPos-1);
  221.             SetOpt; {interpret OptChr and OptStr}
  222.             Delete(ParStr, 1, ChrPos-1);
  223.             {now the next space or '/' is in ParStr[1]}
  224.             ChrPos:= Pos('/', ParStr);        {look for next '/'}
  225.             while (Length(ParStr) > 2) and (ParStr[1] = ' ')
  226.                 and ((ParStr[2] = '/') or (ParStr[2] = ' '))
  227.             do Delete(ParStr, 1, 1);
  228.         end;
  229.     end; {while}
  230. end; {TCmdLine.ParseOpts}
  231.  
  232. {-------------------------------------------------------}
  233.  
  234. {RptError: display error message, and halt/explain/ignore:}
  235. {example: Can not find file(s): "yourfile.ext". }
  236. {Dispose is 'i', 'u', or 'h': see below:}
  237.  
  238. procedure TCmdLine.RptError(Complaint, Name: string; Dispose: char);
  239. begin
  240.     if (Dispose = 'u') or (Dispose = 'h') then AppDone;
  241.     write(Complaint, ': "', Name, '".');
  242.     case Dispose of
  243.         'i': {Ignore} begin
  244.             writeln(' (ignored)');
  245.             exit;
  246.         end;
  247.  
  248.         'u': {show Usage & halt} begin
  249.             writeln;
  250.             ShowUsage;
  251.             Halt;
  252.         end;
  253.  
  254.         'h': {Halt} begin
  255.             writeln;
  256.             Halt;
  257.         end;
  258.     end;
  259.     writeln;    {ignore without saying so}
  260. end; {TCmdLine.RptError}
  261.  
  262. {-------------------------------------------------------}
  263.  
  264. {ScanPars: scan the command line, process according to syntax:}
  265. { Parameters starting with '/' are processed by ParseOpts.      }
  266. { Parameters with '*' or '?' are expanded per DOS convention  }
  267. {    (by directory search) to possibly more than one file and  }
  268. {    processed by DoFile( , true) if MayExpand is true.          }
  269. { Other parameters are processed by DoFile( , false); these   }
  270. {    may or may not be filenames.                              }
  271.  
  272. procedure TCmdLine.ScanPars;
  273. var
  274.     EFiles: word;
  275.     PN:     word;
  276.     ParStr: string;
  277.     ChrPos: integer;
  278.     Path: PathStr;    {expanded pathname, may have wildcards}
  279.                     {Path = Dir + Name + Ext}
  280.     Name: NameStr;    {may have wildcards}
  281.     Ext:  ExtStr;    {may have wildcards, includes '.'}
  282.  
  283. begin
  284.     FileNo:= 0;
  285.     FPars:= 0;
  286.     for PN:= 1 to ParamCount do begin
  287.         ParNo:= PN;
  288.         ParStr:= ParamStr(PN);
  289.         if ParStr[1] = '/' then ParseOpts(ParStr)
  290.         else begin
  291.  
  292.             if MayExpand and
  293.                 ((Pos('*',ParStr) > 0) or (Pos('?',ParStr) > 0))
  294.             then begin
  295.                 EFiles:= 0;
  296.                 inc(FPars);         {count filename parameters}
  297.                 Path:= FExpand(ParStr);
  298.                 FSplit(Path, Dir, Name, Ext);
  299.  
  300.                 {search the directory:}
  301.                 FindFirst(Path, AttrMask, SRec);
  302.                 while DosError = 0 do begin
  303.                     inc(FileNo);    {count all files}
  304.                     inc(EFiles);    {count exanded files for each ParStr}
  305.                     DoFile(Dir + Srec.Name, true);
  306.                     FindNext(SRec);
  307.                 end;
  308.                 if EFiles = 0 then RptError(sCantFind, Path, dCantFind);
  309.  
  310.             end else begin
  311.                 {ParStr is not necessarily a filename:}
  312.                 {DoFile may or may not inc FPars and FileNo:}
  313.                 DoFile(ParStr, false);
  314.             end;
  315.  
  316.         end; {if '/'}
  317.     end; {for}
  318. end; {TCmdLine.ScanPars}
  319.  
  320. {-------------------------------------------------------}
  321.  
  322. {SetOpt: set the option named OptChr to the value given by OptStr:}
  323. { Uses GetBool for booleans; e.g., /a+ /b /c- : a,b true, c false }
  324. { Uses GetInt for integers; e.g., /a-16 /b23 : sets a= -16, b= 23 }
  325. { String values are direct; e.g., /fSomeName : sets f= 'SomeName' }
  326.  
  327. procedure TCmdLine.SetOpt;
  328. begin
  329.     Abstract;
  330. end; {TCmdLine.SetOpt}
  331.  
  332. { If SetOpt uses OptChr to define options: }
  333. {    Option is the '/c' in '/c12'    }
  334. {    OptChr:is the 'c'  in '/c12'    }
  335. {    OptStr:is the '12' in '/c12'    }
  336.  
  337. { If SetOpt uses Optn:= ExtendOpt to define options: }
  338. {   Option is the '/co' in '/co12'    or '/c' in '/c' }
  339. {    Optn   is the 'co'    in '/co12'    or 'c'    in '/c' }
  340. {    OptStr is the '12'    in '/co12'    or ''    in '/c' }
  341.  
  342.     { outline of method to override }
  343. (***
  344.     {
  345.         to use 2-char Optn instead of OptChr:
  346.             Optn:= ExtendOpt;
  347.         .. and use 2-level case:
  348.             case Optn[1] of ..
  349.                 case Optn[2] of ..
  350.     }
  351.     case OptChr of
  352.  
  353.         {process options here}
  354.         {use "if ParNo < 0" for initial-only options}
  355.  
  356.         {examples:}
  357.         'b': BFlag:= GetBool;
  358.         'i': IValue:= GetInt;
  359.         's': StringVal:= OptStr;
  360.  
  361.         '?': begin
  362.             PAppDone;
  363.             ShowUsage;
  364.             Halt;
  365.         end;
  366.  
  367.         {none of the above:}
  368.         else RptError('Undefined option', Option, 'u');
  369.     end;
  370. ***)
  371.  
  372. {-------------------------------------------------------}
  373.  
  374. {ShowUsage: explain command-line parameters and options:}
  375.  
  376. procedure TCmdLine.ShowUsage;
  377. begin
  378.     Abstract;
  379. end; {TCmdLine.ShowUsage}
  380.  
  381.     { outline of method to override }
  382. (***
  383.     writeln(Copyright);
  384.     writeln('Usage:');
  385.  
  386.     {explain parameters & options here}
  387.  
  388.     writeln('Default options are: ', GetDefaults(Config.data));
  389. ***)
  390.  
  391. {*******************************************************}
  392.  
  393. {ExeDir: Get directory of program file if possible, else '':}
  394.  
  395. function ExeDir: DirStr;
  396. var
  397.     Dir: DirStr;
  398.     Name: NameStr;
  399.     Ext: ExtStr;
  400. begin
  401.     If Lo(DosVersion) >= 3 then begin
  402.         FSplit(ParamStr(0), Dir, Name, Ext);
  403.         ExeDir:= Dir;
  404.     end else ExeDir:= '';
  405. end; {ExeDir}
  406.  
  407. {-------------------------------------------------------}
  408.  
  409. {ExeName: Get name of program file if possible, else '':}
  410.  
  411. function ExeName: NameStr;
  412. var
  413.     Dir: DirStr;
  414.     Name: NameStr;
  415.     Ext: ExtStr;
  416. begin
  417.     If Lo(DosVersion) >= 3 then begin
  418.         FSplit(ParamStr(0), Dir, Name, Ext);
  419.         ExeName:= Name;
  420.     end else ExeName:= '';
  421. end; {ExeName}
  422.  
  423. {-------------------------------------------------------}
  424.  
  425. {GetDefaults: get default option string:}
  426. {strips any trailing '/' (padding) characters}
  427.  
  428. function GetDefaults(DefOpts: string): string;
  429. var
  430.     ChrPos: integer;
  431.  
  432. begin
  433.     ChrPos:= Pos('//', DefOpts) - 1;
  434.     if ChrPos < 0 then begin
  435.         ChrPos:= Length(DefOpts);
  436.         if DefOpts[ChrPos] = '/' then dec(ChrPos);
  437.     end;
  438.     GetDefaults:= Copy(DefOpts, 1, ChrPos);
  439. end; {GetDefaults}
  440.  
  441. {-------------------------------------------------------}
  442.  
  443. {StripPadding: strip any trailing '/' (padding) characters:}
  444.  
  445. function StripPadding(Opts: string): string;
  446. var
  447.     ChrPos: integer;
  448. begin
  449.     ChrPos:= Pos('//', Opts) - 1;
  450.     if ChrPos < 0 then begin
  451.         ChrPos:= Length(Opts);
  452.         if Opts[ChrPos] = '/' then dec(ChrPos);
  453.     end;
  454.     StripPadding:= Copy(Opts, 1, ChrPos);
  455. end; {StripPadding}
  456.  
  457. end.
  458.